home *** CD-ROM | disk | FTP | other *** search
/ MacWorld: Complete Mac Interactive / Macworld Complete Mac Interactive CD)(1994).iso / Software / More Shareware⁄Freeware / NIH Image 1.55 f (non fpu) / Macros / LUT Macros < prev    next >
Text File  |  1994-04-05  |  9KB  |  440 lines
  1. macro 'Export LUT [E]';
  2. {Copies the current look-up table to a text window.}
  3. var
  4.   i:integer;
  5.   v:real;
  6.   tab:string;
  7. begin
  8.   RequiresVersion(1.54);
  9.   NewTextWindow('LUT',200,400);
  10.   tab:=chr(9);
  11.   for i:=0 to 255 do
  12.     Writeln(i:4,tab,RedLut[i]:4,tab,GreenLut[i]:4,tab,BlueLut[i]:4);
  13. end;
  14.  
  15. macro 'Import Text LUT';
  16. {
  17. Imports a LUT stored as three column (red, green, blue)
  18. text file. If there are four columns then the first column
  19. is assumed to conatin sequence numbers and is ignored.
  20. }
  21. var
  22.   i,r,g,b, width, height, start, row:integer;
  23. begin
  24.   RequiresVersion(1.53);
  25.   SetImport('Text');
  26.   Import('');
  27.   GetPicSize(width,height);
  28.   if width=3 then begin
  29.     r:=0;
  30.     g:=1;
  31.     b:=2
  32.   end else if width=4 then begin
  33.       r:=1;
  34.       g:=2;
  35.       b:=3
  36.   end else begin
  37.     PutMessage('The text file must have either 3 or 4 columns.');
  38.     exit;
  39.   end;
  40.   if height=255 then
  41.     start:=1
  42.   else if height=256 then
  43.       start:=0
  44.   else begin
  45.       PutMessage('The text file must have either 255 or 256 rows.');
  46.       exit;
  47.    end;
  48.   i:=start;
  49.   row:=0;
  50.   repeat
  51.     RedLut[i]:=GetPixel(r,row);
  52.     GreenLut[i]:=GetPixel(g,row);
  53.     BlueLut[i]:=GetPixel(b,row);
  54.     if (i mod 10) = 0 then UpdateLUT;
  55.     i:=i+1;
  56.     row:=row+1;
  57.   until row>=height;
  58.   UpdateLUT;
  59. end;
  60.  
  61. macro 'Invert LUT [I]';
  62. var
  63.   i:integer;
  64. begin
  65.   for i:=1 to 254 do begin
  66.     RedLUT[i]:=255-RedLut[i];
  67.     GreenLUT[i]:=255-GreenLut[i];
  68.     BlueLUT[i]:=255-BlueLut[i];
  69.   end;
  70.   UpdateLUT;
  71. end;
  72.  
  73.  
  74. macro 'Log Tranform';
  75. var
  76.   i,v:integer;
  77.   ln255:real;
  78. BEGIN
  79.   RedLUT[255]:=0;
  80.   GreenLUT[255]:=0;
  81.   BlueLUT[255]:=0;
  82.   ln255:=ln(255);
  83.   for i:=1 to 255 DO begin
  84.     v:=round(ln(i)*255.0/ln255);
  85.     RedLUT[255-i]:=v;
  86.     GreenLUT[255-i]:=v;
  87.     BlueLUT[255-i]:=v;
  88.   end;
  89.   UpdateLUT;
  90. END.
  91.  
  92.  
  93. macro 'Gamma Tranform… [G]';
  94. var
  95.   i,v:integer;
  96.   n,mode,min,max:integer
  97.   gamma,mean:real;
  98. begin
  99.   gamma:=GetNumber('Gamma(0.1-3.0):',2);
  100.   measure;
  101.   GetResults(n,mean,mode,min,max);
  102.   ShowMessage('min=',min:1,'\max=',max:1);
  103.   for i:=1 to 254 DO begin
  104.     if (i>min) and (i<max)
  105.       then v:=exp(gamma*ln((i-min)/(max-min)))*255 {x^y=exp(y*ln(x)}
  106.       else begin
  107.         if i<=min then v:=0 else v:=255;
  108.       end;
  109.     RedLUT[i]:=255-v;
  110.     GreenLUT[i]:=255-v;
  111.     BlueLUT[i]:=255-v;
  112.   end;
  113.   UpdateLUT;
  114. end;
  115.  
  116.  
  117. macro 'Square Transform';
  118. var
  119.   i,v:integer;
  120.   sqr255:real;
  121. BEGIN
  122.   sqr255:=sqr(255.0);
  123.   for i:=1 to 255 DO begin
  124.     v:=round(sqr(i)*255.0/sqr255);
  125.     RedLUT[255-i]:=v;
  126.     GreenLUT[255-i]:=v;
  127.     BlueLUT[255-i]:=v;
  128.   end;
  129.   UpdateLUT;
  130. END.
  131.  
  132. macro 'Parabolic Transform';
  133. { Generates a parabolic LUT}
  134. var
  135.   i,y:integer;
  136.   scale:real;
  137. begin
  138.   scale:=1;
  139.   for i:= 1 to 254 do begin
  140.     y:= (i-127)*(i-127)*scale/64.25;
  141.     if y > 255 then y:=255;
  142.     RedLUT[i]:=y;
  143.     GreenLUT[i]:= y;
  144.     BlueLUT[i]:=y;
  145.   end;
  146.   UpdateLUT;
  147. end;
  148.  
  149. macro 'Square Root Tranform';
  150. var
  151.   i,v:integer;
  152.   sqrt255:real;
  153. BEGIN
  154.   sqrt255:=sqrt(255.0);
  155.   for i:=1 to 255 DO begin
  156.     v:=round(sqrt(i)*255.0/sqrt255);
  157.     RedLUT[255-i]:=v;
  158.     GreenLUT[255-i]:=v;
  159.     BlueLUT[255-i]:=v;
  160.   end;
  161.   UpdateLUT;
  162. END;
  163.  
  164.  
  165. macro 'Reset LUT [R]';
  166. begin
  167.   ResetGrayMap;
  168. end;
  169.  
  170.  
  171. macro 'Plot LUT [P]';
  172. var
  173.   i,xscale,yscale:real;
  174.   width,height,margin,pwidth,pheight:integer;
  175.   xbase,ybase:integer;
  176. begin
  177.   SaveState;
  178.   margin:=25;
  179.   pwidth:=400;
  180.   pheight:=125;
  181.   width:=pwidth+2*margin;
  182.   height:=pheight*3+2*margin;
  183.   SetNewSize(width,height);
  184.   SetBackground(0); 
  185.   MakeNewWindow('LUT');
  186.   xscale:=(pwidth-2)/256;
  187.   yscale:=(pheight-1)/256;
  188.   SetForeground(252);
  189.   xbase:=margin; ybase:=margin;
  190.   MoveTo(xbase,ybase);
  191.   for i:=0 to 255 do
  192.     LineTo(xbase+i*xscale,ybase+RedLUT[i]*yscale);
  193.   SetForeground(255);
  194.   MakeRoi(xbase,ybase,pwidth,pheight);
  195.   FlipVertical;
  196.   DrawBoundary;
  197.   SetForeground(253);
  198.   ybase:=ybase+pheight-1;
  199.   MoveTo(xbase,ybase);
  200.   for i:=0 to 255 do
  201.     LineTo(xbase+i*xscale,ybase+GreenLUT[i]*yscale);
  202.   SetForeground(255);
  203.   MakeRoi(xbase,ybase,pwidth,pheight);
  204.   FlipVertical;
  205.   DrawBoundary;
  206.   SetForeground(254);
  207.   ybase:=ybase+pheight-1;
  208.   MoveTo(xbase,ybase);
  209.   for i:=0 to 255 do
  210.     LineTo(xbase+i*xscale,ybase+BlueLUT[i]*yscale);
  211.   SetForeground(255);
  212.   MakeRoi(xbase,ybase,pwidth,pheight);
  213.   FlipVertical;
  214.   DrawBoundary;
  215.   KillRoi;
  216.   RedLUT[252]:=255; GreenLUT[252]:=0;   BlueLUT[252]:=0;
  217.   RedLUT[253]:=0;   GreenLUT[253]:=255; BlueLUT[253]:=0;
  218.   RedLUT[254]:=0;   GreenLUT[254]:=0;   BlueLUT[254]:=255;
  219.   UpdateLUT;
  220.   SetFont('Geneva');
  221.   SetFontSize(9);
  222.   SetText('Centered');
  223.   MoveTo(margin+4,height-margin+8);
  224.   writeln(0:1:2);
  225.   MoveTo(margin+pwidth,height-margin+8);
  226.   writeln(255:1:2);
  227.   RestoreState;
  228. end;
  229.  
  230.  
  231. macro 'Posterize…';
  232. var
  233.   level,i:integer
  234.   delta,steps,StepSize,NextStep:real;
  235. begin
  236.   steps:=GetNumber('Number of Gray Steps(2-256):',8);
  237.   StepSize:=256/steps;
  238.   delta:=256/(steps-1);
  239.   NextStep:=trunc(StepSize);
  240.   level:=255;
  241.   for i:=0 to 255 do begin
  242.     if i>=NextStep then begin
  243.       NextStep:=trunc(NextStep+StepSize);
  244.       level:=level-delta;
  245.       UpdateLUT;
  246.     end;
  247.     if level<0 then level:=0;
  248.     RedLUT[i]:=level;
  249.     GreenLUT[i]:=level;
  250.     BlueLUT[i]:=level;
  251.   end;
  252. end;
  253.  
  254.  
  255. macro 'Make Four Ramp LUT';
  256. var
  257.   i,entry:integer;
  258. BEGIN
  259.   entry:=0;
  260.   for i:=0 to 63 DO begin
  261.     RedLUT[entry]:=255-i*4;
  262.     GreenLUT[entry]:=255-i*4;
  263.     BlueLUT[entry]:=255-i*4;
  264.     entry:=entry+1;
  265.   end;
  266.   for i:=0 to 63 DO begin
  267.     RedLUT[entry]:=255-i*4;
  268.     GreenLUT[entry]:=0;
  269.     BlueLUT[entry]:=0;
  270.     entry:=entry+1;
  271.   end;
  272.    for i:=0 to 63 DO begin
  273.     RedLUT[entry]:=0;
  274.     GreenLUT[entry]:=255-i*4;
  275.     BlueLUT[entry]:=0;
  276.     entry:=entry+1;
  277.   end;
  278.   for i:=0 to 63 DO begin
  279.     RedLUT[entry]:=0;
  280.     GreenLUT[entry]:=0;
  281.     BlueLUT[entry]:=255-i*4;
  282.     entry:=entry+1;
  283.   end;
  284.   UpdateLUT;
  285. end.
  286.  
  287.  
  288. macro 'Set Pixels Red…';
  289. var
  290.  v1,v2,i:integer;
  291. begin
  292.     v1:=GetNumber('Starting Pixel Value(1-254)',10);
  293.     v2:=GetNumber('Ending Pixel Value(1-254)',10);
  294.     if v2<v1 then begin
  295.       PutMessage('Ending value less than starting value.');
  296.       exit;
  297.     end;
  298.     for i:=v1 to v2 do begin
  299.       RedLUT[i]:=255;
  300.       GreenLUT[i]:=0;
  301.       BlueLUT[i]:=0;
  302.     end;
  303.   end;
  304.   UpdateLUT;
  305. end;
  306.  
  307.  
  308. macro 'Nearly Gray LUT…';
  309. {
  310. Here is a macro that changes the LUT to make the values near 128 fairly visible when making polygon and line selections which use XOR drawing mode.
  311. Play around with it to get better results. It was written on the
  312. (incorrect) assumption that brightness = r+g+b.
  313. j is i xor 255 and also white is 255,255,255 not 0,0,0.
  314. {The brightness of each pixel is not quite right, there is a better way to get different colors with same brightness...)
  315. --Edward J. Huff (huff@mcclb0.med.nyu.edu)
  316. }
  317. var
  318.  i,j,d: integer;
  319. begin
  320.    while (d < 1) or (d > 63) do
  321.      d := GetNumber('Amount of color',20);
  322.   for i := d*2 to 127 do begin
  323.      j := 255 - i; 
  324.      RedLUT[i] := j + d;
  325.      GreenLUT[i] := j + d;
  326.      BlueLUT[i] := j - d*2;
  327.      RedLUT[j] := i - d*2;
  328.      GreenLUT[j] := i + d;
  329.      BlueLUT[j] := i + d;
  330.   end;
  331.   UpdateLUT;
  332. end;
  333.  
  334. macro 'Color Merge Two Images';
  335. {
  336. Merges a "red" image and a "green" image to create a
  337. composite color image. The macro does this by scaling both
  338. images to 0-15, multiplying the second by 16, creating a
  339. single 8-bit by ORing the two 4-bit images, and then
  340. generating a custom red and green LUT to display the
  341. composite image.
  342. }
  343. var
  344.   i,w1,w2,h1,h2,merged:integer;
  345. begin
  346.   SaveState;
  347.   if nPics<>2 then begin
  348.     PutMessage('This macro operates on exactly two images.');
  349.     exit;
  350.   end;
  351.   SelectPic(1);
  352.   GetPicSize(w1,h1);
  353.   SelectPic(2);
  354.   GetPicSize(w2,h2);
  355.   if (w1<>w2) or (h1<>h2) then begin
  356.     PutMessage('The two images must have the same width and height.');
  357.     exit;
  358.   end;
  359.   SetNewSize(w1,h2);
  360.   MakeNewWindow('Merged');
  361.   merged:=PicNumber;
  362.   SelectPic(1);
  363.   SelectAll;
  364.   Copy;
  365.   SelectPic(merged);
  366.   Paste;
  367.   SelectAll;
  368.   MultiplyByConstant(1/16);
  369.   ChangeValues(0,0,1);
  370.   ChangeValues(16,16,15);
  371.   SelectPic(2);
  372.   SelectAll;
  373.   Duplicate('Temp');
  374.   MultiplyByConstant(1/16);
  375.   ChangeValues(16,16,15);
  376.   MultiplyByConstant(16);
  377.   ChangeValues(0,0,1);
  378.   SelectAll;
  379.   Copy;
  380.   SelectPic(merged);
  381.   Paste;
  382.   DoOr;
  383.   for i:=0 to 255 do begin
  384.      RedLut[i]:=(i mod 16)*16;
  385.      GreenLut[i]:=(i div 16)*16;
  386.      BlueLut[i]:=0;
  387.    end;
  388.   UpdateLut;
  389.   SelectPic(nPics);
  390.   Dispose;  {Temp}
  391.   RestoreState;
  392. end;
  393.  
  394.  
  395. macro 'Move Slice Up [U]';
  396. var
  397.   lower,upper:integer;
  398. begin
  399.   GetThresholds(lower,upper);
  400.   lower:=lower-1;
  401.   upper:=upper-1;
  402.   if lower<1 then lower:=1;
  403.   if lower>254 then lower:=254;
  404.   if upper<lower then upper:=lower;
  405.   if upper>254 then upper:=254;
  406.   SetDensitySlice(lower,upper);
  407.   ShowMessage(lower:4,upper:4)
  408. end;
  409.  
  410. macro 'Move Slice Down [D]';
  411. var
  412.   lower,upper:integer;
  413. begin
  414.   GetThresholds(lower,upper);
  415.   lower:=lower+1;
  416.   upper:=upper+1;
  417.   if lower<1 then lower:=1;
  418.   if lower>254 then lower:=254;
  419.   if upper<lower then upper:=lower;
  420.   if upper>254 then upper:=254;
  421.   SetDensitySlice(lower,upper);
  422.   ShowMessage(lower:4,upper:4)
  423. end;
  424.  
  425. macro 'Change One LUT Entry…';
  426. var
  427.   dn:integer;
  428. begin
  429.   dn:=GetNumber('Gray Value(1-254):',128);
  430.   RedLut[dn]:=GetNumber('Red(0-255):',255);
  431.   GreenLut[dn]:=GetNumber('Green(0-255):',0);
  432.   BlueLut[dn]:=GetNumber('Blue(0-255):',0);
  433.   UpdateLUT;
  434. end;
  435.  
  436. macro 'Sort LUT by Hue';
  437. begin
  438.   SortPalette;
  439. end;
  440.